home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2002 #11 / Amiga Plus CD - 2002 - No. 11.iso / Tools / Development / PowerD / powerd / source / h2m.d < prev    next >
Text File  |  2002-10-28  |  31KB  |  1,238 lines
  1. //
  2. // h2m.d - c include into d ascii module converter by Martin <MarK> Kuchinka (2000-2001)
  3. //
  4. // history:
  5. // 1.0 initial release
  6. //
  7. // 1.1 1.7.2000
  8. //   - added enumerations
  9. //
  10. // 1.2 18.11.2000
  11. //   - '*' doesn't have to be right before the name in structure definition
  12. //
  13. // 1.3 14.1.2001
  14. //   - now the source name can contain the '.h'
  15. //   - now removes the 'xxx_' in 'xxx_yyy' in item names
  16. //   - added recognition for function pointers in structures, requires dc v0.17 or newer
  17. //   - added typedef support, requires dc v0.17 or newer
  18. //
  19. // 1.4 10.2.2001
  20. //   - structs defined by union keyword are now recognised
  21. //
  22. // 1.5 19.6.2001
  23. //   - improved reading of structures
  24. //   - 'short' and 'unsigned xxx' types supported
  25. //
  26. // 1.6 7.7.2001
  27. //   - #if defined(xxx) in now recognized as #ifdef xxx
  28. //   - typedefs as items in structures doesn't freeze anymore (I hope)
  29. //   - typedef like structure supported
  30. //
  31. // 1.7 30.9.2001
  32. //   - removed result typing in function pointers defined in structures
  33. //   - added the #undef support
  34. //
  35. // 1.8 21.1.2002
  36. //   - structs enclosed with it's names are now supported
  37. //
  38. // 1.9 29.5.2002 (reported by Michel Bagmeijer)
  39. //   - fixed conversion: text0x39 was translated to text$39
  40. //   - items in structs now supports mutlidimensional arrays (upto 3d)
  41. //// - enum can now read computed values
  42. //
  43. // todo:
  44. //   - macros inside the structure/typedef
  45. // macro to constant optimizer
  46.  
  47. OPT    OPTIMIZE
  48.  
  49. MODULE    'exec/memory'
  50.  
  51. RAISE    "^C"  IF CtrlC()=TRUE,
  52.         "MEM" IF AllocPooled()=NIL,
  53.         "MEM" IF AllocVecPooled()=NIL
  54.  
  55. ENUM    SOURCE,NOCOMMENT,OPTIMIZE
  56. SET    F_NOCOMMENT,F_OPTIMIZE
  57.  
  58. DEF    pool,flags=0,global:PTR TO data
  59.  
  60. BYTE '\n\n$VER: h2m v1.9 by MarK (\xt \x5d)\n\n\n\0'
  61.  
  62. PROC main()
  63.     DEF    args:PTR TO LONG,ra,
  64.             name[256]:STRING,dest[256]:STRING,
  65.             src:PTR TO CHAR,l,f=NIL,data
  66.     args:=[NIL,FALSE,FALSE]:LONG
  67.     IFN ra:=ReadArgs('SOURCE/A,NC=NOCOMMENT/S,O=OPTIMIZE/S',args,NIL) THEN Raise("DOS")
  68.     IF StrCmp(args[SOURCE]+StrLen(args[SOURCE])-2,'.h')
  69.         StrCopy(name,args[SOURCE])
  70.         StrCopy(dest,args[SOURCE])
  71.         dest[StrLen(dest)-1]:="m"
  72.     ELSE
  73.         StringF(name,'\s.h',args[SOURCE])
  74.         StringF(dest,'\s.m',args[SOURCE])
  75.     ENDIF
  76.     IF args[NOCOMMENT] THEN flags:=F_NOCOMMENT
  77.     IF args[OPTIMIZE] THEN flags|=F_OPTIMIZE
  78.     IF (l:=FileLength(name))<=0 THEN Raise("DOS")
  79.     IFN pool:=CreatePool(MEMF_PUBLIC|MEMF_CLEAR,16384,4096) THEN Raise("MEM")
  80.     src:=AllocVecPooled(pool,l+16)
  81.     IF f:=Open(name,OLDFILE)
  82.         Read(f,src,l)
  83.         Close(f)
  84.         f:=NIL
  85.         global:=data:=ReadC(src,l)
  86.     ELSE Raise("DOS")
  87.     IF flags & F_OPTIMIZE THEN Optimize(data)
  88.     IF f:=Open(dest,NEWFILE)
  89.         WriteD(f,data)
  90.         VFPrintF(f,'\n',NIL)
  91.         Close(f)
  92.         f:=NIL
  93.     ELSE Raise("DOS")
  94. EXCEPTDO
  95.     SELECT exception
  96.     CASE "DOS";    PrintFault(IOErr(),'h2m')
  97.     CASE "MEM";    PrintF('\s: not enough memory\n','h2m')
  98.     CASE "EOF";    PrintF('\s: unexpected eof (\d)\n','h2m',exceptioninfo)
  99.     CASE "^C";    PrintF('\s: ***break \s\n','h2m',exceptioninfo)
  100.     CASE "TYP";    PrintF('\s: unknown type (\d)\n','h2m',exceptioninfo)
  101.     CASE "PTR";    PrintF('\s: too deep pointer (\d)\n','h2m',exceptioninfo)
  102.     CASE "STX";    PrintF('\s: syntax error (\d)\n','h2m',exceptioninfo)
  103.     ENDSELECT
  104.     IF f THEN Close(f)
  105.     IF pool THEN DeletePool(pool)
  106.     IF ra THEN FreeArgs(ra)
  107. ENDPROC
  108.  
  109. OBJECT data
  110.     what:WORD,            // DA...
  111.     next:PTR TO macro
  112.  
  113. ENUM    DA_None,
  114.         DA_Comment,
  115.         DA_OBJECT,        // struct
  116.         DA_STRUCT,        // struct inside an object
  117.         DA_UNION,
  118.         DA_ITEM,
  119.         DA_ENUM,            // enum
  120.         DA_Macro,
  121.         DA_TDEF,            // typedef
  122.         DA_OConst        // constant generated by optimizer
  123.  
  124. OBJECT comment OF data
  125.     comment:PTR TO CHAR
  126.  
  127. OBJECT obj OF data
  128.     name:PTR TO CHAR,
  129.     comment:PTR TO comment,
  130.     item:PTR TO item
  131.  
  132. OBJECT item OF data
  133.     name:PTR TO CHAR,
  134.     comment:PTR TO comment,
  135.     type:UBYTE,                // DT...
  136.     flags:UBYTE,            // IF...
  137.     size:LONG,
  138.     size2:LONG,
  139.     size3:LONG,
  140.     obj:PTR TO CHAR        // obj/NIL
  141.  
  142. OBJECT enum OF data
  143.     first:PTR TO const
  144.  
  145. OBJECT const
  146.     next:PTR TO const,
  147.     name:PTR TO CHAR,
  148.     value:LONG,
  149.     comment:PTR TO comment
  150.  
  151. SET    IF_UNION,                    // item is an UNION
  152.         IF_FUNC
  153.  
  154. ENUM    DT_VOID,                        // cut from dc.e
  155.         DT_LONG,
  156.         DT_ULONG,
  157.         DT_WORD,
  158.         DT_UWORD,
  159.         DT_BYTE,
  160.         DT_UBYTE,
  161.         DT_FLOAT,
  162.         DT_DOUBLE,
  163.         DT_BOOL,
  164.         DT_CUSTOM,                    -> object - global field
  165.         DT_PTR,                        -> VOID pointer
  166.         DT_DLONG,
  167.         DT_UDLONG,
  168.         DT_STRING,
  169.         DT_BASE,
  170.         DT_FUNC,                        // function pointer
  171.         DT_STRUCT                    // typedef structure/object
  172.  
  173. OBJECT macro OF data
  174.     type:WORD,
  175.     name:PTR TO CHAR,
  176.     args:PTR TO CHAR,
  177.     comment:PTR TO CHAR,
  178.     mline:PTR TO mline
  179.  
  180. ENUM    MT_define,
  181.         MT_include,
  182.         MT_ifdef,
  183.         MT_ifndef,
  184.         MT_endif,
  185.         MT_if,
  186.         MT_else,
  187.         MT_undef
  188.  
  189. OBJECT mline
  190.     next:PTR TO mline,
  191.     data:PTR TO CHAR,
  192.     comment:PTR TO CHAR
  193.  
  194. OBJECT typedef OF data
  195.     type:WORD,                        // DT...
  196.     obj:PTR TO CHAR,
  197.     name:PTR TO CHAR,                // new type name
  198.     object:PTR TO obj
  199.  
  200. OBJECT oconst OF data
  201.     name:PTR TO CHAR,
  202.     value:LONG,
  203.     comment:PTR TO comment
  204.  
  205. PROC ReadC(src:PTR TO CHAR,l)(L)
  206.     DEF    last=NIL:PTR TO data,frst=NIL:PTR TO data,pos=0,
  207.             data:PTR TO data,name[80]:CHAR
  208.     WHILE pos<l
  209.         data:=NIL
  210.         pos:=Crop(src,pos,l)
  211.         IF Word(src+pos)="//"||Word(src+pos)="/*"
  212. //        IF (src[pos]="/"&&src[pos+1]="/")||(src[pos]="/"&&src[pos+1]="*")
  213.             pos,data:=Comment(src,pos,l)
  214.         ELSEIF src[pos]="#"
  215.             pos,data:=Macro(src,pos,l)
  216.         ELSE
  217.             pos:=GetName(name,src,pos,l)
  218.             IF StrCmp(name,'struct')
  219.                 pos,data:=OBJECT(src,pos,l)
  220.             ELSEIF StrCmp(name,'union')
  221.                 pos,data:=OBJECT(src,pos,l)
  222.             ELSEIF StrCmp(name,'enum')
  223.                 pos,data:=ENUM(src,pos,l)
  224.             ELSEIF StrCmp(name,'typedef')
  225.                 pos,data:=TYPEDEF(src,pos,l)
  226.             ELSE
  227.                 pos++
  228.             ENDIF
  229.             name[0]:="\0"
  230.         ENDIF
  231.         IFN frst THEN frst:=data
  232.         IF  last THEN last.next:=data
  233.         IF  data THEN last:=data
  234.         WHILE last.next DO last:=.next
  235.         CtrlC()
  236.         IF CtrlD() THEN RETURN frst
  237.     EXITIF src[pos]="\0"
  238.     ENDWHILE
  239. ENDPROC frst
  240.  
  241. // read one or more comments if available
  242. PROC Comment(src:PTR TO CHAR,pos,l)(LONG,PTR TO comment)
  243.     DEF    opos=pos,comment=NIL:PTR TO comment,data:PTR TO CHAR,first=NIL:PTR TO comment,
  244.             last=NIL:PTR TO comment
  245.     WHILE Word(src+pos)="//"
  246.         WHILE src[pos]<>"\n"
  247.             pos++
  248.             CtrlC()
  249.         ENDWHILE
  250.     ELSEWHILE Word(src+pos)="/*"
  251.         REPEAT
  252.             pos++
  253.             CtrlC()
  254.         UNTIL Word(src+pos)="*/"
  255.         pos+=2
  256.     ALWAYS
  257.         IFN flags&F_NOCOMMENT
  258.             comment:=AllocPooled(pool,SIZEOF_comment)
  259.             comment.what:=DA_Comment
  260.             data:=AllocVecPooled(pool,pos-opos+4)
  261.             StrCopy(data,src+opos,pos-opos)
  262.             comment.comment:=data
  263. //            PrintF('(\d) \s\n',opos,data)
  264.             IFN first THEN first:=comment
  265.             IF last THEN last.next:=comment
  266.             last:=comment
  267.         ENDIF
  268. //        pos:=Crop(src,pos,l)
  269.         opos:=pos
  270.     ENDWHILE
  271. ENDPROC pos,first
  272.  
  273. PROC OBJECT(src:PTR TO CHAR,pos,l,etype=FALSE)(LONG,PTR TO obj)
  274.     DEF    name[80]:CHAR,obj:PTR TO obj,next=TRUE,item:PTR TO item,type,objn:PTR TO CHAR,
  275.             last=NIL:PTR TO item,ptr,opos,func,havename=FALSE
  276.     obj:=AllocPooled(pool,SIZEOF_obj)
  277.     obj.what:=DA_OBJECT
  278.     pos:=Skip(src,pos,l)
  279.     IF src[pos]="{"
  280.         pos++
  281.         havename:=FALSE
  282.     ELSE
  283.         pos:=Skip(src,pos,l)
  284.         pos:=GetName(name,src,pos,l)
  285.         obj.name:=AllocPooled(pool,StrLen(name)+4)
  286.         StrCopy(obj.name,name)
  287.         pos:=Crop(src,pos,l)
  288.         pos,obj.comment:=Comment(src,pos,l)
  289.         pos:=Skip(src,pos,l)
  290.         IF src[pos]="{" THEN pos++ //ELSE Raise("STX",pos)
  291.         havename:=TRUE
  292.     ENDIF
  293. //    PrintF('(\d) \s\n',pos,obj.name)
  294.     WHILE next
  295.         opos:=pos:=Skip(src,pos,l)
  296.         pos:=GetName(name,src,pos,l,TRUE)    // read type
  297. //        PrintF('(\d) \s\n',pos,name)
  298.         objn:=NIL
  299.         func:=FALSE
  300.         next:=TRUE
  301.  
  302.         SELECT TRUE
  303.         CASE StrCmp(name,'int'),StrCmp(name,'long'),StrCmp(name,'LONG')
  304.                                                 type:=DT_LONG
  305.         CASE StrCmp(name,'ULONG');        type:=DT_ULONG
  306.         CASE StrCmp(name,'WORD');        type:=DT_WORD
  307.         CASE StrCmp(name,'void');        type:=DT_VOID
  308.         CASE StrCmp(name,'UWORD');        type:=DT_UWORD
  309.         CASE StrCmp(name,'short');        type:=DT_WORD
  310.         CASE StrCmp(name,'BYTE');        type:=DT_BYTE
  311.         CASE StrCmp(name,'UBYTE'),StrCmp(name,'char')
  312.                                                 type:=DT_UBYTE
  313.         CASE StrCmp(name,'STRPTR');    type:=DT_UBYTE|%100000
  314.         CASE StrCmp(name,'float');        type:=DT_FLOAT
  315.         CASE StrCmp(name,'double');    type:=DT_DOUBLE
  316.         CASE StrCmp(name,'short');        type:=DT_WORD
  317.         CASE StrCmp(name,'unsigned long');    type:=DT_ULONG
  318.         CASE StrCmp(name,'unsigned short');    type:=DT_UWORD
  319.         CASE StrCmp(name,'unsigned char');    type:=DT_UBYTE
  320.         CASE StrCmp(name,'unsigned int');    type:=DT_ULONG
  321.         CASE StrCmp(name,'APTR'),StrCmp(name,'BPTR'),StrCmp(name,'CPTR')
  322.                                                 type:=DT_PTR
  323.         CASE StrCmp(name,'struct');    type:=DT_CUSTOM
  324.             pos:=Skip(src,pos,l)
  325.             IF src[pos]="{"
  326.                 pos,item:=OBJECT(src,pos,l,DA_STRUCT)
  327.                 pos:=Skip(src,pos,l)
  328. //                PrintF('(\d) \s\n',pos,item.name)
  329.                 IFN obj.item THEN obj.item:=item
  330.                 IF last THEN last.next:=item
  331.                 last:=item
  332.                 next:=FALSE
  333.             ELSE
  334.                 pos:=GetName(name,src,pos,l)
  335.                 objn:=AllocPooled(pool,StrLen(name)+4)
  336.                 StrCopy(objn,name)
  337.                 pos:=Skip(src,pos,l)
  338. //                PrintF('1(\d) \s\n',pos,item.name)
  339.             ENDIF
  340.         CASE StrCmp(name,'union');        type:=DT_CUSTOM
  341.             pos:=Skip(src,pos,l)
  342.             IF src[pos]="{"
  343.                 pos,item:=OBJECT(src,pos,l,DA_UNION)
  344.                 pos:=Skip(src,pos,l)
  345. //                PrintF('(\d) \s\n',pos,item.name)
  346.                 IFN obj.item THEN obj.item:=item
  347.                 IF last THEN last.next:=item
  348.                 last:=item
  349.                 next:=FALSE
  350.             ELSE
  351.                 pos:=GetName(name,src,pos,l)
  352.                 objn:=AllocPooled(pool,StrLen(name)+4)
  353.                 StrCopy(objn,name)
  354.                 pos:=Skip(src,pos,l)
  355.             ENDIF
  356.         DEFAULT;                                type:=DT_CUSTOM
  357.             objn:=AllocPooled(pool,StrLen(name)+4)
  358.             StrCopy(objn,name)
  359.             pos:=Skip(src,pos,l)
  360. //            Raise("TYP",opos)
  361.         ENDSELECT
  362.  
  363. //        PrintF('type=\d\n',type)
  364.  
  365.         // next is TRUE
  366.         WHILE next
  367.             pos:=Skip(src,pos,l)
  368.             item:=AllocPooled(pool,SIZEOF_item)
  369.             item.what:=DA_ITEM
  370.             item.obj:=objn
  371.             item.type:=type
  372.             IF src[pos]="("
  373.                 func:=TRUE
  374.                 pos:=Skip(src,pos+1,l)
  375.             ENDIF
  376.             ptr:=0
  377.             WHILE src[pos]="*" DO pos++;    ptr++
  378.             pos:=Skip(src,pos,l)
  379.             IF ptr>4 THEN Raise("PTR",pos)
  380.             item.type|=ptr<<5
  381.             pos:=GetName(name,src,pos,l)
  382.             item.name:=AllocPooled(pool,StrLen(name)+4)
  383.             StrCopy(item.name,name)
  384. //            PrintF('(\d) \s(\d)\n',pos,name,ptr)
  385.             pos:=Crop(src,pos,l)
  386.             IF func
  387.                 IF src[pos]=")"
  388.                     pos:=Skip(src,pos+1,l)
  389.                     IF src[pos]="(" THEN pos:=Skip(src,pos+1,l) ELSE Raise("STX",pos)
  390.                     IF src[pos]=")" THEN pos:=Crop(src,pos+1,l) ELSE Raise("STX",pos)
  391.                     item.flags|=IF_FUNC
  392.                 ELSE
  393.                     Raise("STX",pos)
  394.                 ENDIF
  395.             ENDIF
  396. //            PrintF('(\d) \s\n',pos,name)
  397.             IF src[pos]="["
  398.                 opos:=++pos
  399.                 pos:=Find("]",src,pos,l)
  400.                 StrCopy(name,src+opos,pos-opos)
  401.                 C2D(name)
  402.                 item.size:=AllocPooled(pool,StrLen(name)+4)
  403.                 StrCopy(item.size,name)
  404.                 pos++
  405.             ENDIF
  406.             IF src[pos]="["
  407.                 opos:=++pos
  408.                 pos:=Find("]",src,pos,l)
  409.                 StrCopy(name,src+opos,pos-opos)
  410.                 C2D(name)
  411.                 item.size2:=AllocPooled(pool,StrLen(name)+4)
  412.                 StrCopy(item.size2,name)
  413.                 pos++
  414.             ENDIF
  415.             IF src[pos]="["
  416.                 opos:=++pos
  417.                 pos:=Find("]",src,pos,l)
  418.                 StrCopy(name,src+opos,pos-opos)
  419.                 C2D(name)
  420.                 item.size3:=AllocPooled(pool,StrLen(name)+4)
  421.                 StrCopy(item.size3,name)
  422.                 pos++
  423.             ENDIF
  424.             pos:=Crop(src,pos,l)
  425.             IF src[pos]=","
  426.                 next:=TRUE
  427.                 pos++
  428.             ELSE
  429.                 next:=FALSE
  430.             ENDIF
  431.             pos:=Crop(src,pos,l)
  432.             pos,item.comment:=Comment(src,pos,l)
  433.             pos:=Skip(src,pos,l)
  434.             IFN obj.item THEN obj.item:=item
  435.             IF last THEN last.next:=item
  436.             last:=item
  437.             CtrlC()
  438.         ENDWHILE
  439.         CtrlC()
  440.     EXITIF src[pos]="}" DO pos:=Crop(src,pos+1,l)
  441.         next:=TRUE
  442.     ENDWHILE
  443.     IF havename=FALSE
  444.         pos:=Skip(src,pos,l)
  445.         pos:=GetName(name,src,pos,l)
  446. //        PrintF('(\d) \s\n',pos,name)
  447.         obj.name:=AllocPooled(pool,StrLen(name)+4)
  448.         StrCopy(obj.name,name)
  449.         pos:=Crop(src,pos,l)
  450.         pos,obj.comment:=Comment(src,pos,l)
  451.     ENDIF
  452. ENDPROC pos,obj
  453.  
  454. PROC TYPEDEF(src:PTR TO CHAR,pos,l)(LONG,PTR TO typedef)
  455.     DEF    tdef:PTR TO typedef,name[64]:STRING,type,obj=NIL:PTR TO CHAR,object:PTR TO obj
  456.     tdef:=AllocPooled(pool,SIZEOF_typedef)
  457.     tdef.what:=DA_TDEF
  458.     pos:=Skip(src,pos,l)
  459.     pos:=GetName(name,src,pos,l)
  460.     pos:=Skip(src,pos,l)
  461.     SELECT TRUE
  462.     CASE StrCmp(name,'struct')
  463.         pos,object:=OBJECT(src,pos,l,DA_STRUCT)
  464.         object.what:=DA_OBJECT
  465.         type:=DT_STRUCT
  466.         obj:=object.name
  467.         tdef.object:=object
  468. //        PrintF('\s,\d\n',obj,pos)
  469.     CASE StrCmp(name,'int');        type:=DT_LONG
  470.     CASE StrCmp(name,'LONG');        type:=DT_LONG
  471.     CASE StrCmp(name,'ULONG');        type:=DT_ULONG
  472.     CASE StrCmp(name,'float');        type:=DT_FLOAT
  473.     CASE StrCmp(name,'double');    type:=DT_DOUBLE
  474.     CASE StrCmp(name,'short');        type:=DT_WORD
  475.     CASE StrCmp(name,'unsigned long');    type:=DT_ULONG
  476.     CASE StrCmp(name,'unsigned short');    type:=DT_UWORD
  477.     CASE StrCmp(name,'unsigned char');    type:=DT_UBYTE
  478.     DEFAULT;                                type:=DT_CUSTOM
  479.         obj:=AllocPooled(pool,StrLen(name)+4)
  480.         StrCopy(obj,name)
  481.     ENDSELECT
  482.     IF type<>DT_STRUCT
  483.         pos:=GetName(name,src,pos,l)
  484.         pos:=Skip(src,pos,l)
  485.         tdef.name:=AllocPooled(pool,StrLen(name)+4)
  486.         StrCopy(tdef.name,name)
  487.     ENDIF
  488.  
  489.     tdef.type:=type
  490.     tdef.obj:=obj
  491. ENDPROC pos,tdef
  492.  
  493. PROC ENUM(src:PTR TO CHAR,pos,l)(LONG,PTR TO ENUM)
  494.     DEF    enum:PTR TO enum,next=TRUE,const:PTR TO const,prev=NIL:PTR TO const
  495.     DEF    name[256]:STRING,value=0,opos
  496.     enum:=AllocPooled(pool,SIZEOF_enum)
  497.     enum.what:=DA_ENUM
  498.     pos:=Skip(src,pos,l)
  499.     pos:=GetName(name,src,pos,l)
  500.     pos:=Skip(src,pos,l)
  501. //    PrintF('\d=\s\n',pos,name)
  502.     IF src[pos]<>"{" THEN Raise("STX",pos) ELSE pos++
  503.     WHILE next
  504.         value:=NIL
  505.         pos:=Skip(src,pos,l)
  506.         const:=AllocPooled(pool,SIZEOF_const)
  507.         IFN enum.first THEN enum.first:=const
  508.         IF prev THEN prev.next:=const
  509.  
  510.         pos:=GetName(name,src,pos,l)
  511.         const.name:=AllocPooled(pool,StrLen(name)+4)
  512.         StrCopy(const.name,name)
  513.  
  514.         pos:=Skip(src,pos,l)
  515. //        PrintF('1=\d\n',pos)
  516.         IF src[pos]="="
  517. //            pos,value:=GetNum(src,pos+1,l)
  518.  
  519.             opos:=++pos
  520.             pos:=Find(",",src,pos,l)
  521.             StrCopy(name,src+opos,pos-opos)
  522.             C2D(name)
  523.             value:=AllocPooled(pool,StrLen(name)+4)
  524.             StrCopy(value,name)
  525.  
  526.         ENDIF
  527. //        PrintF('2=\d\n',pos)
  528.  
  529.         const.value:=value
  530.  
  531.         pos:=Crop(src,pos,l)
  532.         pos,const.comment:=Comment(src,pos,l)
  533.         pos:=Skip(src,pos,l)
  534. //        PrintF('3=\d\n',pos)
  535.  
  536. //        PrintF('\s=\s\n',const.name,const.value)
  537.  
  538.         IF src[pos]=","
  539.             pos++
  540.         ELSEIF src[pos]="}"
  541.             next:=FALSE
  542.             pos++
  543.         ELSE
  544.             Raise("STX",pos)
  545.         ENDIF
  546.  
  547. //        value++
  548.         prev:=const
  549.     ENDWHILE
  550. ENDPROC pos,enum
  551.  
  552. PROC Macro(src:PTR TO CHAR,pos,l)(LONG,PTR TO macro)
  553.     DEF    opos,macro=NIL:PTR TO macro,name[80]:STRING,next,ml,
  554.             line:PTR TO mline,last:PTR TO mline,buf[1024]:STRING,cpos
  555.     macro:=AllocPooled(pool,SIZEOF_macro)
  556.     macro.what:=DA_Macro
  557.     pos:=Skip(src,pos,l)
  558.     pos:=GetName(name,src,pos,l)
  559.     IF StrCmp(name,'#define')
  560.         macro.type:=MT_define
  561.         pos:=Skip(src,pos,l)
  562.         pos:=GetName(name,src,pos,l)
  563.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  564.         StrCopy(macro.name,name)
  565.         IF src[pos]="("
  566.             opos:=pos
  567.             pos:=Find(")",src,pos,l)
  568.             macro.args:=AllocPooled(pool,pos-opos+4)
  569.             StrCopy(macro.args,src+opos,pos-opos)
  570.         ENDIF
  571.         next:=TRUE
  572.         last:=NIL
  573.         WHILE next
  574.             opos:=pos
  575.             pos:=MaCrop(src,pos,l)
  576.             line:=AllocPooled(pool,SIZEOF_mline)
  577.             StrCopy(buf,src+opos,pos-opos)
  578.             cpos:=C2D(buf)
  579.             ml:=StrLen(buf)+1
  580.             IF cpos<100000 THEN ml-=ml-cpos
  581.             line.data:=AllocPooled(pool,ml+4)
  582.             StrCopy(line.data,buf,ml-1)
  583. //            PrintF('\s\n',line.data)
  584.             IF src[pos]="\\"
  585.                 pos++
  586.                 next:=TRUE
  587.                 pos:=Crop(src,pos,l)
  588.                 pos,line.comment:=Comment(src,pos,l)
  589.             ELSE
  590.                 next:=FALSE
  591.                 IF cpos<100000 THEN pos,line.comment:=Comment(src,opos+cpos,l)
  592.                 pos++                // skip "\n"
  593.             ENDIF
  594.             IFN macro.mline THEN macro.mline:=line
  595.             IF last THEN last.next:=line
  596.             last:=line
  597.             CtrlC()
  598.         ENDWHILE
  599.     ELSEIF StrCmp(name,'#ifdef')
  600.         macro.type:=MT_ifdef
  601.         pos:=Skip(src,pos,l)
  602.         pos:=GetName(name,src,pos,l)
  603.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  604.         pos:=Skip(src,pos,l)
  605.         StrCopy(macro.name,name)
  606.     ELSEIF StrCmp(name,'#ifndef')
  607.         macro.type:=MT_ifndef
  608.         pos:=Skip(src,pos,l)
  609.         pos:=GetName(name,src,pos,l)
  610.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  611.         StrCopy(macro.name,name)
  612.     ELSEIF StrCmp(name,'#endif')
  613.         macro.type:=MT_endif
  614.     ELSEIF StrCmp(name,'#include')
  615.         macro.type:=MT_include
  616.         pos:=Skip(src,pos,l)
  617.         IF src[pos]="\q"
  618.             opos:=++pos
  619.             WHILE src[pos]<>"\q" DO pos++
  620.             buf[0]:="*"
  621.             StrCopy(buf+1,src+opos,pos-opos)
  622.         ELSEIF src[pos]="<"
  623.             opos:=++pos
  624.             WHILE src[pos]<>">" DO pos++
  625.             StrCopy(buf,src+opos,pos-opos)
  626.         ENDIF
  627.         ml:=StrLen(buf)
  628.         IF buf[ml-2]="."&&buf[ml-1]="h" THEN buf[ml-2]:="\0"
  629.         macro.name:=AllocPooled(pool,ml+4)
  630.         StrCopy(macro.name,buf)
  631.         pos++                // skip "\q" or ">"
  632.     ELSEIF StrCmp(name,'#if')
  633.         macro.type:=MT_if
  634.         pos:=Skip(src,pos,l)
  635.         pos:=GetName(name,src,pos,l)
  636.         IF StrCmp(name,'defined') AND src[pos]="("
  637.             pos:=Skip(src,pos+1,l)
  638.             pos:=GetName(name,src,pos,l)
  639.             pos:=Skip(src,pos,l)
  640.             IF src[pos]<>")" THEN Raise("STX",pos)
  641.             macro.type:=MT_ifdef
  642.         ENDIF
  643.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  644.         pos:=Skip(src,pos,l)
  645.         StrCopy(macro.name,name)
  646.     ELSEIF StrCmp(name,'#undef')
  647.         macro.type:=MT_undef
  648.         pos:=Skip(src,pos,l)
  649.         pos:=GetName(name,src,pos,l)
  650.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  651.         pos:=Skip(src,pos,l)
  652.         StrCopy(macro.name,name)
  653.     ELSEIF StrCmp(name,'#else')
  654.         macro.type:=MT_else
  655.     ENDIF
  656. ENDPROC pos,macro
  657.  
  658. // this function replaces: '->' to '.', '0x' to '$'
  659. PROC C2D(src:PTR TO CHAR)(LONG)
  660.     DEF    spos=0,dpos=0,l=StrLen(src),cpos=100000
  661.     WHILE spos<l        // dpos is always smaller or equal then spos
  662.         IF src[spos]="-"&&src[spos+1]=">"
  663.             src[dpos]:="."
  664.             spos++
  665.         ELSEIF src[spos]="0"&&src[spos+1]="x"
  666.             IFN IsAlpha2Num(src[spos-1])
  667.                 src[dpos]:="$"
  668.                 spos++
  669.             ELSE
  670.                 src[dpos]:=src[spos]
  671.             ENDIF
  672. //        ELSEIF IsHex(src[spos])&&src[spos+1]="L"
  673.         ELSEIF src[spos]>="0"&&src[spos]<="9"&&src[spos+1]="L"
  674.             src[dpos]:=src[spos]
  675.             spos++
  676.         ELSEIF src[spos]>="0"&&src[spos]<="9"&&src[spos+1]="U"&&src[spos+2]="L"
  677.             src[dpos]:=src[spos]
  678.             spos+++
  679.         ELSEIF src[spos]="\q"
  680.             src[dpos]:="\a"
  681.         ELSEIF src[spos]="\a"
  682.             src[dpos]:="\q"
  683.         ELSEIF src[spos]="%"
  684.             src[dpos]:="\\"
  685.         ELSEIF src[spos]="/"&&src[spos+1]="/"
  686.             IF cpos=100000 THEN cpos:=spos
  687.         ELSEIF src[spos]="/"&&src[spos+1]="*"
  688.             IF cpos=100000 THEN cpos:=spos
  689.         ELSE
  690.             src[dpos]:=src[spos]
  691.         ENDIF
  692.         spos++
  693.         dpos++
  694.         CtrlC()
  695.     ENDWHILE
  696.     src[dpos]:="\0"
  697. ENDPROC cpos            // position of comment
  698.  
  699. PROC WriteD(f,data:PTR TO macro)
  700.     DEF    prev
  701.     WHILE data
  702.         prev:=data
  703.         // this loop removes #ifndef and #endif lines from destination
  704.         WHILE data.what=DA_Macro&&data.type=MT_ifndef
  705.             DEF    next=data.next:PTR TO macro
  706.             IF next
  707.                 IF next.what=DA_Macro&&next.type=MT_include
  708.                     IF next.next.what=DA_Macro&&next.next.type=MT_endif
  709.                         WriteMacro(f,next)
  710.                         IF next.next THEN IFN data:=next.next.next THEN RETURN
  711.                     ENDIF
  712.                 ENDIF
  713.             ENDIF
  714.         EXITIF prev=data
  715.         ENDWHILE
  716.         SELECT data.what
  717.         CASE DA_Comment;    WriteComment(f,data)
  718.         CASE DA_OBJECT;    WriteOBJECT(f,data)
  719.         CASE DA_ENUM;        WriteENUM(f,data)
  720.         CASE DA_Macro;        WriteMacro(f,data)
  721.         CASE DA_TDEF;        WriteTDEF(f,data)
  722.         CASE DA_OConst;    data:=WriteCONST(f,data)
  723.         DEFAULT;                PrintF('\d\n',data.what)
  724.         ENDSELECT
  725.         data:=.next
  726.         CtrlC()
  727.     ENDWHILE
  728. ENDPROC
  729.  
  730. PROC WriteComment(f,comment:PTR TO comment)
  731.     FPrintF(f,'\s\n',comment.comment)
  732. ENDPROC
  733.  
  734. PROC WriteOBJECT(f,obj:PTR TO obj,level=0)
  735.     DEF    item:PTR TO item,maxl=0,l
  736.  
  737. //    PrintF('Yeah(\s)\n',obj.name)
  738.  
  739.     item:=obj.item
  740.     ReNameAllItems(item)
  741.  
  742.     // find maximal name length
  743.     WHILE item DO IF (l:=ItemLen(item))>maxl THEN maxl:=l;    item:=.next;    CtrlC()
  744.     IF maxl>80 THEN maxl:=1
  745.  
  746.     IF level>0 THEN FOR l:=1 TO level FPrintF(f,'\t', NIL)
  747.     IF obj.what=DA_OBJECT
  748.         FPrintF(f,'OBJECT \s',obj.name)
  749.         IF obj.comment
  750.             l:=StrLen(item)+3
  751.             WHILE l<maxl DO l++;    FPrintF(f,' ',NIL)
  752.             WriteD(f,obj.comment)
  753.         ELSE
  754.             FPrintF(f,'\n',NIL)
  755.         ENDIF
  756.     ELSEIF obj.what=DA_UNION
  757.         FPrintF(f,'[CUNION\n',obj.name)
  758.     ELSEIF obj.what=DA_STRUCT
  759.         FPrintF(f,'[\n',obj.name)
  760.     ENDIF
  761.  
  762.     item:=obj.item
  763.     WHILE item
  764.         IF item.what=DA_UNION||item.what=DA_STRUCT||item.what=DA_OBJECT
  765.             WriteOBJECT(f,item,level+1)
  766.         ELSE
  767.             FOR l:=0 TO level FPrintF(f,'\t', NIL)
  768.             FPrintF(f,'\s',item.name)
  769.             IF item.flags&IF_FUNC
  770.                 /*IF (item.type&$1f)<>DT_VOID THEN FPrintF(f,'()(\s\s)',TypeStr(item.type-32),item.obj) ELSE*/ VFPrintF(f,'()')
  771.             ELSE
  772.                 IF item.size3
  773.                     FPrintF(f,'[\s,\s,\s]',item.size,item.size2,item.size3)
  774.                 ELSEIF item.size2
  775.                     FPrintF(f,'[\s,\s]',item.size,item.size2)
  776.                 ELSEIF item.size
  777.                     FPrintF(f,'[\s]',item.size)
  778.                 ENDIF
  779.                 FPrintF(f,':\s',TypeStr(item.type))
  780.                 IF item.obj THEN FPrintF(f,item.obj,NIL)
  781.             ENDIF
  782.         ENDIF
  783.         IF item.next THEN FPrintF(f,',',NIL)
  784.         IF item.comment
  785.             l:=ItemLen(item)
  786.             l-=4
  787.             IFN item.next THEN l--
  788.             WHILE l<maxl DO l++;    FPrintF(f,' ',NIL)
  789.             WriteComment(f,item.comment)
  790.         ELSE
  791.             FPrintF(f,'\n',NIL)
  792.         ENDIF
  793.         item:=.next
  794.         CtrlC()
  795.     ENDWHILE
  796.     IF level>0 THEN FOR l:=1 TO level FPrintF(f,'\t', NIL)
  797.     IF obj.what=DA_OBJECT
  798.         IF level>0
  799.             FPrintF(f,'ENDOBJECT',NIL)
  800.         ELSE
  801.             FPrintF(f,'\n',NIL)
  802.         ENDIF
  803.     ELSEIF obj.what=DA_STRUCT
  804.         FPrintF(f,']:\s',obj.name)
  805.     ELSEIF obj.what=DA_UNION
  806.         FPrintF(f,'ENDUNION]:\s',obj.name)
  807.     ENDIF
  808. ENDPROC
  809.  
  810. PROC WriteTDEF(f,tdef:PTR TO typedef)
  811.     IF tdef.type<>DT_STRUCT
  812.         FPrintF(f,'TDEF\t\s:\s',tdef.name,TypeStr(tdef.type))
  813.         IF tdef.obj THEN FPrintF(f,'\s\n',tdef.obj)
  814.         FPrintF(f,'\n',NIL)
  815.     ELSE
  816.         IF tdef.object THEN WriteOBJECT(f,tdef.object)
  817.     ENDIF
  818. ENDPROC
  819.  
  820. PROC ReNameAllItems(first:PTR TO item)
  821.     DEF    pre[16]:CHAR,n=0,len,item=first:PTR TO item
  822.  
  823.     // find the "_" to get the
  824.     len:=StrLen(item.name)
  825.     WHILE item.name[n]<>"_"
  826.         IF n=>len THEN RETURN
  827.         pre[n]:=item.name[n]
  828.         n++
  829.     ENDWHILE
  830.     pre[n++]:="_"
  831.     pre[n]:="\0"
  832.  
  833.     WHILE item
  834.         IF StrCmp(item.name,pre,n)=FALSE THEN RETURN
  835.         item:=.next
  836.     ENDWHILE
  837.  
  838.     item:=first
  839.     WHILE item
  840.         item.name+=n
  841.         item:=.next
  842.     ENDWHILE
  843. ENDPROC
  844.  
  845. PROC WriteENUM(f,enum:PTR TO enum)
  846.     DEF    const:PTR TO const
  847.     const:=enum.first
  848.     FPrintF(f,'ENUM\t',NIL)
  849.     WHILE const
  850.         IF const<>enum.first THEN FPrintF(f,'\t\t',NIL)
  851.         FPrintF(f,'\s',const.name)
  852.         IF const.value
  853.             FPrintF(f,'=\s',const.value)
  854.         ENDIF
  855.         const:=const.next
  856.         IF const THEN FPrintF(f,',',NIL)
  857.         FPrintF(f,'\n',NIL)
  858.         CtrlC()
  859.     ENDWHILE
  860.     FPrintF(f,'\n',NIL)
  861. ENDPROC
  862.  
  863. PROC WriteMacro(f,macro:PTR TO macro)
  864.     SELECT macro.type
  865.     CASE MT_define
  866.         DEF    line:PTR TO mline
  867.         FPrintF(f,'#define \s\s',macro.name,macro.args)
  868.         line:=macro.mline
  869.         WHILE line
  870.             FPrintF(f,' \s',line.data)
  871.             IF line.next THEN FPrintF(f,'\\',NIL)
  872.             IF line.comment
  873.                 FPrintF(f,'\t',NIL)
  874.                 WriteD(f,line.comment)
  875.             ELSE FPrintF(f,'\n',NIL)
  876.             line:=.next
  877.             CtrlC()
  878.         ENDWHILE
  879.     CASE MT_include
  880.         IFN StrCmp(macro.name,'exec/types') THEN FPrintF(f,'MODULE\t''\s''\n',macro.name)
  881.     CASE MT_ifdef
  882.         FPrintF(f,'#ifdef \s\n',macro.name)
  883.     CASE MT_ifndef
  884.         FPrintF(f,'#ifndef \s\n',macro.name)
  885.     CASE MT_endif
  886.         FPrintF(f,'#endif\n',NIL)
  887.     CASE MT_if
  888.         FPrintF(f,'#if \s\n',macro.name)
  889.     CASE MT_undef
  890.         FPrintF(f,'#undefine \s\n',macro.name)
  891.     CASE MT_else
  892.         FPrintF(f,'#else\n',NIL)
  893.     ENDSELECT
  894. ENDPROC
  895.  
  896. PROC WriteCONST(f,const:PTR TO oconst)(PTR TO oconst)
  897.     FPrintF(f,'CONST\t\s=\d',const.name,const.value)
  898.     IF const.next
  899.         IF const.next.what=DA_OConst
  900.             IF const:=.next
  901.                 WHILE const.what=DA_OConst
  902.                     FPrintF(f,',\n\t\t\s=\d',const.name,const.value)
  903.                 EXITIF const.next=NIL
  904.                     const:=.next
  905.                 ENDWHILE
  906.             ENDIF
  907.             FPrintF(f,'\n',NIL)
  908.         ENDIF
  909.     ELSE FPrintF(f,'\n',NIL)
  910. ENDPROC const
  911.  
  912. PROC ItemLen(item:PTR TO item)(L)
  913.     DEF    l,ptr
  914.     l:=IF item.name THEN StrLen(item.name) ELSE 0
  915.     IF item.size THEN l+=StrLen(item.size)+2
  916.     IF item.obj THEN l+=StrLen(item.obj)
  917.     SELECT item.type&$1f                                        // add ':type'
  918.     CASE DT_PTR;                                                l+=4
  919.     CASE DT_LONG,DT_WORD,DT_BYTE,DT_BOOL,DT_VOID;    l+=5
  920.     CASE DT_ULONG,DT_UWORD,DT_UBYTE,DT_FLOAT;            l+=6
  921.     CASE DT_DOUBLE;                                            l+=7
  922.     DEFAULT;                                                        l++
  923.     ENDSELECT
  924.     ptr:=item.type>>5
  925.     l+=ptr*7                    // length of 'PTR TO '
  926. ENDPROC l
  927.  
  928. PROC TypeStr(type)(PTR TO CHAR)
  929.     DEF    str:PTR TO CHAR
  930.     SELECT type
  931.     CASE 1;    str:='LONG'
  932.     CASE 2;    str:='ULONG'
  933.     CASE 3;    str:='WORD'
  934.     CASE 4;    str:='UWORD'
  935.     CASE 5;    str:='BYTE'
  936.     CASE 6;    str:='UBYTE'
  937.     CASE 7;    str:='FLOAT'
  938.     CASE 8;    str:='DOUBLE'
  939.     CASE 9;    str:='BOOL'
  940.     CASE 10;    str:=NIL
  941.     CASE 11;    str:='PTR'
  942.     CASE 12;    str:='DLONG'
  943.     CASE 13;    str:='UDLONG'
  944.     CASE 14;    str:='STRING'
  945.  
  946.     CASE 33;    str:='PTR TO LONG'
  947.     CASE 34;    str:='PTR TO ULONG'
  948.     CASE 35;    str:='PTR TO WORD'
  949.     CASE 36;    str:='PTR TO UWORD'
  950.     CASE 37;    str:='PTR TO BYTE'
  951.     CASE 38;    str:='PTR TO UBYTE'
  952.     CASE 39;    str:='PTR TO FLOAT'
  953.     CASE 40;    str:='PTR TO DOUBLE'
  954.     CASE 41;    str:='PTR TO BOOL'
  955.     CASE 42;    str:='PTR TO '
  956.     CASE 43;    str:='PTR TO PTR'
  957.     CASE 44;    str:='PTR TO DLONG'
  958.     CASE 45;    str:='PTR TO UDLONG'
  959.     CASE 46;    str:='PTR TO CHAR'
  960.  
  961.     CASE 65;    str:='PTR TO PTR TO LONG'
  962.     CASE 66;    str:='PTR TO PTR TO ULONG'
  963.     CASE 67;    str:='PTR TO PTR TO WORD'
  964.     CASE 68;    str:='PTR TO PTR TO UWORD'
  965.     CASE 69;    str:='PTR TO PTR TO BYTE'
  966.     CASE 70;    str:='PTR TO PTR TO UBYTE'
  967.     CASE 71;    str:='PTR TO PTR TO FLOAT'
  968.     CASE 72;    str:='PTR TO PTR TO DOUBLE'
  969.     CASE 73;    str:='PTR TO PTR TO BOOL'
  970.     CASE 74;    str:='PTR TO PTR TO '
  971.     CASE 75;    str:='PTR TO PTR TO PTR'
  972.     CASE 76;    str:='PTR TO PTR TO DLONG'
  973.     CASE 77;    str:='PTR TO PTR TO UDLONG'
  974.     CASE 78;    str:='PTR TO PTR TO CHAR'
  975.  
  976.     CASE 129;str:='LIST OF LONG'
  977.     CASE 130;str:='LIST OF ULONG'
  978.     CASE 131;str:='LIST OF WORD'
  979.     CASE 132;str:='LIST OF UWORD'
  980.     CASE 133;str:='LIST OF BYTE'
  981.     CASE 134;str:='LIST OF UBYTE'
  982.     CASE 135;str:='LIST OF FLOAT'
  983.     CASE 136;str:='LIST OF DOUBLE'
  984.     CASE 137;str:='LIST OF BOOL'
  985.     CASE 138;str:='LIST OF '
  986.     CASE 139;str:='LIST OF PTR'
  987.     CASE 140;str:='LIST OF DLONG'
  988.     CASE 141;str:='LIST OF UDLONG'
  989.     CASE 142;str:='LIST OF CHAR'
  990.     DEFAULT;    str:='VOID'
  991.     ENDSELECT
  992. ENDPROC str
  993.  
  994. PROC GetNum(s:PTR TO CHAR,n=0,l)(LONG,LONG)
  995.     DEF    num=0,sign=1
  996.     WHILE s[n]="\t" OR s[n]="\n" OR s[n]=" " DO n++
  997.     IF s[n]="-"
  998.         sign:=-1
  999.         n++
  1000.     ENDIF
  1001.     IF s[n]="0" AND s[n+1]="x"                                    // HEXADECIMAL number
  1002.         n+++
  1003.         WHILE s[n]>="0" AND s[n]<="9"
  1004.             num<<=4
  1005.             num|=s[n]-"0"
  1006.         ELSEWHILE s[n]>="a" AND s[n]<="f"
  1007.             num<<=4
  1008.             num|=s[n]-"a"+10
  1009.         ELSEWHILE s[n]>="A" AND s[n]<="F"
  1010.             num<<=4
  1011.             num|=s[n]-"A"+10
  1012.         ALWAYS
  1013.             n++
  1014.             IF n>l THEN Raise("EOF",n)
  1015.         ENDWHILE
  1016.     ELSE                                                                // DECIMAL number
  1017.         WHILE s[n]>="0" AND s[n]<="9"
  1018.             num*=10
  1019.             num+=s[n]-"0"
  1020.             n++
  1021.             IF n>l THEN Raise("EOF",n)
  1022.         ENDWHILE
  1023.     ENDIF
  1024. ENDPROC n,num*sign
  1025.  
  1026. PROC GetName(name:PTR TO CHAR,src:PTR TO CHAR,pos,length,istype=FALSE)(L,PTR)
  1027.     DEF i=0,c=1
  1028.     IF name
  1029.         IF IsAlpha2(src[pos])
  1030.             WHILE c
  1031.                 WHILE IsAlpha2Num(src[pos])
  1032.                     name[i]:=src[pos]
  1033.                     pos++
  1034.                     i++
  1035.                     CtrlC()
  1036.                     IF pos>length THEN Raise("EOF",pos)
  1037.                 ENDWHILE
  1038.                 name[i]:="\0"
  1039.                 c--
  1040.                 IF istype
  1041.                     IF StrCmp(name,'unsigned')
  1042.                         name[i++]:=" "
  1043.                         pos:=Skip(src,pos,length)
  1044.                         c:=1
  1045.                     ENDIF
  1046.                 ENDIF
  1047.             ENDWHILE
  1048.         ENDIF
  1049.     ELSE
  1050.         IF IsAlpha2(src[pos])
  1051.             WHILE IsAlpha2Num(src[pos])
  1052.                 pos++
  1053.                 CtrlC()
  1054.                 IF pos>length THEN Raise("EOF",pos)
  1055.             ENDWHILE
  1056.             name:=TRUE
  1057.         ENDIF
  1058.     ENDIF
  1059. ENDPROC pos,name
  1060.  
  1061. PROC GetString(str:PTR TO CHAR,src:PTR TO CHAR,pos,length)(L,PTR)
  1062.     DEF i=0
  1063.     IF (src[pos]=34)||(src[pos]="<")
  1064.         pos++
  1065.         WHILE (src[pos]<>34)&&(src[pos]<>">")
  1066.             str[i]:=src[pos]
  1067.             pos++
  1068.             i++
  1069.             CtrlC()
  1070.             IF pos>length THEN Raise("EOF",pos)
  1071.         ENDWHILE
  1072.         str[i]:="\0"
  1073.         pos++                // skip ",>
  1074.     ENDIF
  1075. ENDPROC pos,str
  1076.  
  1077. PROC Find(char,src:PTR TO CHAR,pos,length)(L)
  1078.     WHILE src[pos]<>char
  1079.         pos++
  1080.         CtrlC()
  1081.         IF pos>length THEN Raise("EOF",pos)
  1082.     ENDWHILE
  1083. ENDPROC pos
  1084.  
  1085. PROC FindTDEF(item:PTR TO typedef,name:PTR TO CHAR)(BOOL)
  1086.     WHILE item
  1087.         IF item.what=DA_TDEF
  1088.             IF StrCmp(item.name,name) THEN RETURN TRUE
  1089.         ENDIF
  1090.         CtrlC()
  1091.         item:=.next
  1092.     ENDWHILE
  1093. ENDPROC FALSE
  1094.  
  1095. PROC IsAlpha2(char)(L) IS IF ((char>="A")&&(char<="Z"))||((char>="a")&&(char<="z"))||(char="_")||(char="#") THEN TRUE ELSE FALSE
  1096. PROC IsAlpha2Num(char)(L) IS IF ((char>="A")&&(char<="Z"))||((char>="a")&&(char<="z"))||(char="_")||((char>="0")&&(char<="9"))||(char="#") THEN TRUE ELSE FALSE
  1097. PROC IsFirstNum(char)(L) IS IF ((char>="0")&&(char<="9"))||(char=".")||(char="$")||(char="%")||(char="-") THEN TRUE ELSE FALSE
  1098.  
  1099. // skip whitespaces and comments
  1100. PROC Skip(src:PTR TO CHAR,pos,length)(L)
  1101.     DEF done=FALSE,char
  1102.     REPEAT
  1103.         char:=src[pos]
  1104.         IF char=" "
  1105.             pos++
  1106.         ELSEIF char="\t"
  1107.             pos++
  1108.         ELSEIF char=";"
  1109.             pos++
  1110.         ELSEIF char="\n"
  1111.             pos++
  1112.         ELSEIF char="/"
  1113.             IF src[pos+1]="*"
  1114.                 pos++
  1115.                 REPEAT
  1116.                     pos++
  1117.                     IF pos>length THEN RETURN pos
  1118.                 UNTIL (src[pos-1]="*")&&(src[pos]="/")
  1119.                 pos++
  1120.             ELSEIF src[pos+1]="/"
  1121.                 pos++
  1122.                 REPEAT
  1123.                     pos++
  1124.                     IF pos>length THEN RETURN pos
  1125.                 UNTIL (src[pos]="\n")||((src[pos-1]="/")&&(src[pos]="/"))
  1126.                 pos++
  1127.             ELSE
  1128.                 done:=TRUE
  1129.             ENDIF
  1130.         ELSE
  1131.             done:=TRUE
  1132.         ENDIF
  1133.         IF pos>length THEN Raise("EOF",pos)
  1134.     UNTIL done=TRUE
  1135. ENDPROC pos
  1136.  
  1137. // skip whitespaces only
  1138. PROC Crop(src:PTR TO CHAR,pos,length)(L)
  1139.     DEF done=FALSE,char
  1140.     REPEAT
  1141.         char:=src[pos]
  1142.         IF char=" "
  1143.             pos++
  1144.         ELSEIF char="\t"
  1145.             pos++
  1146.         ELSEIF char=";"
  1147.             pos++
  1148.         ELSEIF char="\n"
  1149.             pos++
  1150.         ELSE
  1151.             done:=TRUE
  1152.         ENDIF
  1153.         IF pos>length THEN Raise("EOF",pos)
  1154.     UNTIL done=TRUE
  1155. ENDPROC pos
  1156.  
  1157. PROC MaCrop(src:PTR TO CHAR,pos,length)(L)
  1158.     DEF    cpos=-1,qpos=-1,apos=-1
  1159.     WHILE src[pos]<>"\n"
  1160.         IF src[pos]="/" AND src[pos+1]="/" THEN cpos:=0
  1161.         IF src[pos]="/" AND src[pos+1]="*" THEN cpos:=0
  1162.         IF src[pos]="*" AND src[pos+1]="/" THEN cpos:=-1
  1163.         IF src[pos]="\q" THEN qpos:=~qpos
  1164.         IF src[pos]="\a" THEN apos:=~apos
  1165.         IF src[pos]="\\" THEN IF cpos=-1 AND qpos=-1 AND apos=-1 THEN RETURN pos
  1166.         pos++
  1167.         IF pos>length THEN Raise("EOF",pos)
  1168.     ENDWHILE
  1169. ENDPROC pos
  1170.  
  1171. PROC Optimize(first:PTR TO data)(PTR)
  1172.     DEF    prev=NIL:PTR TO data,data=first:PTR TO data,cnst:PTR TO oconst
  1173.     DEF    macro:PTR TO macro,mline:PTR TO mline,bool:BOOL,flt:BOOL,value
  1174.  
  1175.     // change all number-only macros to constants
  1176.     WHILE data
  1177.         IF data.what=DA_Macro
  1178.             macro:=data
  1179.             IF macro.type=MT_define && macro.args=NIL
  1180.                 IF mline:=macro.mline
  1181.                     IF mline.next=NIL
  1182.                         IF bool,flt:=CheckNumber(mline.data)
  1183.                             IFN flt
  1184.                                 cnst:=AllocPooled(pool,SIZEOF_oconst)
  1185.                                 cnst.what:=DA_OConst
  1186.                                 cnst.next:=data.next
  1187.                                 cnst.name:=macro.name
  1188.                                 value:=Val(mline.data)
  1189.                                 cnst.value:=value
  1190.                                 cnst.comment:=mline.comment
  1191.                                 IF prev THEN prev.next:=cnst ELSE first:=cnst
  1192.                                 data:=cnst
  1193.                             ENDIF
  1194.                         ENDIF
  1195.                     ENDIF
  1196.                 ENDIF
  1197.             ENDIF
  1198.         ENDIF
  1199.         prev:=data
  1200.         data:=.next
  1201.         CtrlC()
  1202.     ENDWHILE
  1203. ENDPROC first
  1204.  
  1205. PROC CheckNumber(str:PTR TO CHAR)(BOOL,BOOL)
  1206.     DEF    number=TRUE:BOOL,n=0,float=FALSE:BOOL
  1207.     n:=Crop(str,0,StrLen(str))
  1208.     IF IsFirstNum(str[n])
  1209.         n++
  1210.         WHILE str[n]
  1211.             IF IsHex(str[n])
  1212.             ELSEIF str[n]=".";    float:=TRUE
  1213.             ELSE number:=FALSE
  1214.             n++
  1215.         ENDWHILE
  1216.     ELSE number:=FALSE
  1217. ENDPROC number,float
  1218.  
  1219. PROC ComputeMacro(first:PTR TO data,macro:PTR TO macro)
  1220.     DEF    line:PTR TO mline,name[64]:STRING,pos,len,npos
  1221.     DEF    value
  1222.     line:=macro.mline
  1223.     WHILE line
  1224.         pos:=0
  1225.         len:=StrLen(line.data)
  1226. //        pos:=Crop(line.data,pos,len)
  1227.         value:=0
  1228.         WHILE (npos:=GetName(name,line.data,pos,len))>pos
  1229.             SELECT TRUE
  1230.             CASE StrCmp(name,'TAG_USER');    value|=$80000000
  1231.             DEFAULT
  1232.             ENDSELECT
  1233.         ENDWHILE
  1234.         line:=.next
  1235.         CtrlC()
  1236.     ENDWHILE
  1237. ENDPROC
  1238.